home *** CD-ROM | disk | FTP | other *** search
/ Programming Sound Cards / Programming Sound Cards.iso / sound_56 / loadproc.inc < prev    next >
Text File  |  1995-01-01  |  24KB  |  683 lines
  1. FUNCTION SCRMtest(var p):boolean; ASSEMBLER; { yeah asm ! :) }
  2.   asm
  3.      xor      ax,ax
  4.      les      di,p
  5.      cmp      word ptr es:[di],'CS'
  6.      jne      @@endoftest
  7.      cmp      word ptr es:[di+2],'MR'
  8.      jne      @@endoftest
  9.      mov      ax,0101h
  10. @@endoftest:
  11.   end;
  12.  
  13. FUNCTION ST3test(var p):boolean; ASSEMBLER; { I love this :) }
  14.   asm
  15.     xor       ax,ax
  16.     les       di,p
  17.     mov       ax,es:[di]
  18.     cmp       ax,01300h         { saved by ST3.00 }
  19.     jb        @@endoftest
  20.     cmp       ax,01303h         { saved by ST3.01 }
  21.     ja        @@endoftest
  22.     mov       ax,0101h
  23. @@endoftest:
  24.   end;
  25.  
  26. procedure convert2pas(var from,topas;maxchars:byte); ASSEMBLER; { yeah assembler strikes again }
  27.   asm
  28.     push     ds
  29.     lds      si,from
  30.     les      di,topas
  31.     mov      bx,di
  32.     xor      ch,ch
  33.     mov      cl,[maxchars]
  34.     xor      dl,dl              ;{ count of chars in string }
  35.     inc      di                 ;{ first char ... }
  36. @@loop:
  37.     lodsb                       ;{ I know it's slow, but here we don't need speed here ;) }
  38.     test     al,al
  39.     jz       @@nomorechar
  40.     inc      dl                 ;{ copy now one char }
  41.     stosb                       ;{ put it into the destination string }
  42.     loop     @@loop
  43. @@nomorechar:
  44.     mov      es:[bx],dl         ;{ save count of chars }
  45.     pop      ds
  46.   end;
  47.  
  48. function getchtyp(b:byte):byte; ASSEMBLER; { :) what else ... }
  49.   asm
  50.     xor     ah,ah
  51.     mov     al,b
  52.     cmp     al,7
  53.     ja      @@notleft
  54.     mov     al,1        ;{ left }
  55.     jmp     @@endofget
  56. @@notleft:
  57.     cmp     al,15
  58.     ja      @@notright
  59.     mov     al,2        ;{ right }
  60.     jmp     @@endofget
  61. @@notright:
  62.     cmp     al,23
  63.     ja      @@notadlib1
  64.     mov     al,3        ;{ adlib melody }
  65.     jmp     @@endofget
  66. @@notadlib1:
  67.     cmp     al,31
  68.     ja      @@notadlib2
  69.     mov     al,4        ;{ adlib drums }
  70.     jmp     @@endofget
  71. @@notadlib2:
  72.     xor     al,al       ;{ channel off :) }
  73. @@endofget:
  74.   end;
  75.  
  76. FUNCTION  LOAD_S3M(name:string):BOOLEAN;
  77. var f:file;
  78.     header:Theader;
  79.     maxused:byte;
  80.     inspara:array[1..Max_samples] of word;
  81.     patpara:TPatternSarray;
  82.     smppara:ARRAY[0..MAX_samples] OF LONGINT;
  83.     i:byte;
  84.     inspos,patpos,smppos,smpnum:byte;
  85.     nextins,nextpat,nextsmp:longint;
  86.     fileposit:longint;
  87.     wdummy:word;
  88.     p:pointer;
  89.     pAr:PArray;
  90.     buffer:PArray;
  91.     { EMS things: }
  92.     Ppagesleft:byte;  { number of pages left to use for patterns }
  93.     curPpage:byte;    { current logical EMS page we fill with next pattern }
  94.     curpart:byte;     { =0,1,2 -> every page is seperated in 3 parts (one part - one pattern) }
  95.     curSpage:word;    { current logical EMS page we fill with next sample }
  96.     Spagesleft:word;  { number of pages left to use for samples }
  97.     fun:string;
  98.     funptr:pointer;
  99.  
  100.   PROCEDURE allocEMSforSamples;
  101.   var w,w0:word;
  102.       i:integer;
  103.       pSmp:PSMPheader;
  104.     begin
  105.       if EMSfreepages=0 then begin EMSsmp:=false;exit end;
  106.       w:=0;
  107.       for i:=1 to 99 do
  108.         begin
  109.           pSmp:=addr(Instruments^[i]);
  110.           if pSmp^.typ=1 then { really a sample }
  111.             begin
  112.               if pSmp^.flags and 1 = 1 then w0:=pSmp^.loopend+1024 else w0:=pSmp^.length+1024;
  113.               w:=w + w0 div (16*1024) + ord(w0 mod (16*1024)>0);
  114.             end;
  115.         end;
  116.       {$IFDEF BETATEST }
  117.       writeln(' Instruments to load : ',insnum);
  118.       writeln(' EMS pages are needed for Samples : ',w);
  119.       {$ENDIF}
  120.       { w = number of 16Kb pages in EMS }
  121.       if w>EMSfreepages then { not enough EMS for all samples }
  122.         begin
  123.           { use as many pages as possible :) }
  124.           w:=EMSfreepages;
  125.           smpEMShandle:=EMSalloc(w);
  126.         end
  127.       else { oh well enough, that's nice }
  128.         begin
  129.           { fine let's load everything into EMS }
  130.           smpEMShandle:=EMSalloc(w);
  131.         end;
  132.       {$IFDEF BETATEST }
  133.       writeln(' EMS pages allocated for Samples : ',w);
  134.       {$ENDIF}
  135.       Spagesleft:=w;
  136.       EMSsmp:=true;
  137.       curSpage:=0;
  138.     end;
  139.  
  140.   PROCEDURE freeallmem;
  141.     begin
  142.       if buffer<>Nil then freedosmem(buffer);
  143.       done_module;
  144.     end;
  145.  
  146.   PROCEDURE forget(count:longint);
  147.   var dummy:array[0..511] of byte;
  148.       i:word;
  149.     begin
  150.       for i:=1 to count div 512 do blockread(f,dummy,512);
  151.       if count mod 512 >0 then blockread(f,dummy,(count mod 512));
  152.     end;
  153.  
  154.   FUNCTION load_instrument:boolean;
  155.   var length:word;
  156.       typ:byte;
  157.       pAr:Parray;
  158.       Psmp:PSmpHeader;
  159.       PAdl:PAdlHeader;
  160.     BEGIN
  161.       load_instrument:=false;
  162.       { first jump to position }
  163.       if (fileposit>nextins*16) then
  164.         { shit tables not sorted - more disk access }
  165.         begin
  166.           reset(f,1);
  167.           seek(f,nextins*16); { <- we start reading from filestart again
  168.                                 and read till we are at start of this pattern ... }
  169.           if IOresult<>0 then begin load_error:=filecorrupt;exit end;
  170.           {$IFDEF BETATEST}
  171.           writeln(#13#10'somethings going wrong with order. position was: ',fileposit,' but we need : ',nextins*16);
  172.           {$ENDIF}
  173.         end
  174.       else
  175.       if fileposit<nextins*16 then
  176.         { that's better - we only have to forget some blocks }
  177.         forget(nextins*16-fileposit);
  178.       fileposit:=nextins*16;
  179.       {$IFDEF LOADINFO}
  180.       write('I',inspos-1);
  181.       {$ENDIF}
  182.       { now read instrument header : }
  183.       blockread(f,Instruments^[inspos-1],5*16);
  184.       inc(fileposit,5*16);
  185.       pSmp:=addr(instruments^[inspos-1]);
  186.       pAdl:=addr(instruments^[inspos-1]);
  187.       if pSmp^.typ=1 then { that instrument is a sample }
  188.         begin
  189.           if pSmp^.packinfo <> 0 then begin load_error:=packedsamples;exit end;
  190.           { calc position in file : }
  191.           smppara[smpnum]:=(longint(256*256)*pSmp^.HI_mempos+pSmp^.mempos);
  192.           pSmp^.mempos:=0;inc(smpnum);
  193.           {$IFDEF LOADINFO}
  194.           write('!');
  195.           {$ENDIF}
  196.         end
  197.       else
  198.         begin
  199.           smppara[smpnum]:=0;inc(smpnum);
  200.           {$IFDEF LOADINFO}
  201.           write('$');
  202.           {$ENDIF}
  203.         end;
  204.       {$IFDEF LOADINFO}
  205.       write('*');
  206.       {$ENDIF}
  207.       load_instrument:=true;
  208.     END;
  209.  
  210.   FUNCTION load_sample:boolean;
  211.   var p:pointer;
  212.       par:parray;
  213.       pSmp:pSmpHeader;
  214.       z,h:word;
  215.       i:byte;
  216.       smplen:word;
  217.     begin
  218.       load_sample:=false;
  219.       if (fileposit>nextsmp*16) then
  220.         { shit tables not sorted - more disk access }
  221.         begin
  222.           reset(f,1);
  223.           seek(f,nextsmp*16); { <- we start reading from filestart again
  224.                                 and read till we are at start of this pattern ... }
  225.           if IOresult<>0 then begin load_error:=filecorrupt;exit end;
  226.           {$IFDEF BETATEST}
  227.           writeln(#13#10'somethings going wrong with order. position was: ',fileposit,' but we need : ',nextsmp*16);
  228.           {$ENDIF}
  229.         end
  230.       else
  231.       if fileposit<nextsmp*16 then forget(nextsmp*16-fileposit);
  232.  
  233.       fileposit:=nextsmp*16;
  234.       pSmp:=addr(Instruments^[smppos]);
  235.       if (pSmp^.flags and 1)=1 then smplen:=pSmp^.loopend else smplen:=pSmp^.length;
  236.       if smplen>64511 then begin load_error:=sample2large;exit end;
  237.       {$IFDEF LOADINFO}
  238.       write('S',smppos,'(',smplen,')');
  239.       {$ENDIF}
  240.       z:=((smplen+1024) div (16*1024))+ord((smplen+1024) mod (16*1024)>0);
  241.       if useEMS and EMSsmp and (Spagesleft>=z) then
  242.         begin
  243.           {$IFDEF LOADINFO}
  244.           write('E(',curSpage,'-',curSpage+z-1,')');
  245.           {$ENDIF}
  246.           pSmp^.mempos:=$f000+curSpage; { and z-1 pages after }
  247.           for i:=0 to z-1 do
  248.             if not EMSmap(smpEMShandle,curSpage+i,i) then write('<EMS-ERROR>');
  249.           inc(curSpage,z);
  250.           blockread(f,frameptr[0]^,smplen);par:=frameptr[0];
  251.         end
  252.       else { we have to use normal memory (geeee) for this sample }
  253.         begin
  254.           if not getdosmem(p,smplen+1024) then begin load_error:=notenoughmem;exit end;
  255.           blockread(f,p^,smplen);
  256.           pSmp^.mempos:=seg(p^);
  257.           par:=p;
  258.         end;
  259.       if (Psmp^.flags and 1)=1 then
  260.         { if loop then copy from loopstart : }
  261.         begin
  262.           h:=1024;
  263.           while h>0 do
  264.             begin
  265.               if h>psmp^.loopend-psmp^.loopbeg+1 then
  266.                 begin
  267.                   move(par^[psmp^.loopbeg],par^[smplen+1024-h],psmp^.loopend-psmp^.loopbeg);
  268.                   dec(h,psmp^.loopend-psmp^.loopbeg);
  269.                 end
  270.               else
  271.                 begin
  272.                   move(par^[psmp^.loopbeg],par^[smplen+1024-h],h);h:=0;
  273.                 end;
  274.             end;
  275.         end
  276.       else fillchar(par^[smplen],1024,128);
  277.       if (pSmp^.flags and 1 = 1) and (pSmp^.loopend<pSmp^.length) then
  278.         forget(pSmp^.length-pSmp^.loopend);
  279.       inc(fileposit,pSmp^.length);
  280.       if IORESULT<>0 then begin write(' Geeee ... (',fileposit,')');load_error:=filecorrupt;exit end;
  281.       {$IFDEF LOADINFO}
  282.       write('*');
  283.       {$ENDIF}
  284.       load_sample:=true;
  285.     end;
  286.  
  287.   FUNCTION load_decrunc_pattern:boolean;
  288.   var row:byte;
  289.       crunch:byte;
  290.       chn:byte;
  291.       hp,hp2:pointer;
  292.       length:word;
  293.       linecount:byte;
  294.     BEGIN
  295.       load_decrunc_pattern:=false;
  296.       if nextpat=0 then begin load_decrunc_pattern:=true;PATTERN[patpos-1]:=0;exit end;
  297.       { first jump to position }
  298.       if (fileposit>nextpat*16) then
  299.         { shit tables not sorted - more dsik access :( }
  300.         begin
  301.           reset(f,1);
  302.           seek(f,nextpat*16); { <- we start reading from filestart again
  303.                                    and read till we are at start of this pattern ... }
  304.           {$IFDEF BETATEST}
  305.           writeln(#13#10'somethings going wrong with order. position was: ',fileposit,' but we need : ',nextpat*16);
  306.           {$ENDIF}
  307.           if IOresult<>0 then begin load_error:=filecorrupt;exit end;
  308.         end
  309.       else
  310.       if fileposit<nextpat*16 then
  311.         forget(nextpat*16-fileposit);
  312.       fileposit:=nextpat*16;
  313.       blockread(f,length,2); { <- length of packed pattern }
  314.       {$IFDEF LOADINFO}
  315.       write('P',patpos-1,'(',length,')');
  316.       if length>10*1024 then
  317.         begin
  318.           writeln('Packed data longer then 10K - that''s not allowed ...'#7' PROGRAM HALTED.');
  319.           halt;
  320.         end;
  321.       {$ENDIF}
  322.       { read whole packed pattern }
  323.       blockread(f,buffer^,length-2); { length=sizeof(packdata)+(sizeof(length)=2) }
  324.       if IOresult<>0 then begin load_error:=filecorrupt;exit end;
  325.       inc(fileposit,length);
  326.       { first get memory : (if useEMS than try to put it into the EMS ... }
  327.       if useEMS and EMSpat and (curpart<patperpage) then
  328.         begin
  329.           PATTERN[patpos-1]:=$C000+256*curpart+curPpage;
  330.           if not EMSmap(patEMShandle,curPpage,0) then write('<EMS-ERROR>');
  331.           p:=ptr(frameseg[0]+(patlength div 16)*word(curpart),0);
  332.         end
  333.       else
  334.         begin
  335.           if not getdosmem(p,longint(64*5)*usedchannels) then begin load_error:=notenoughmem;exit end;
  336.           PATTERN[patpos-1]:=seg(p^);
  337.         end;
  338.       { we decrunc it now to full size - not all 32 channels,but all used channels }
  339.       hp:=p;hp2:=buffer;
  340.       asm
  341.         { first setup default values. It looks difficult, but it isn't :
  342.           set note FFh,instrument 00,command ffh, options ffh }
  343.         les      di,hp
  344.         xor      ch,ch
  345.         mov      cl,[usedchannels]
  346.         shl      cx,6             ;{ do it for every channel and every row :
  347.                                   ;  usedchannels * 64 }
  348. @@loop: mov      word ptr es:[di  ],00ffh
  349.         mov      word ptr es:[di+2],0ffffh
  350.         mov      byte ptr es:[di+4],0
  351.         add      di,5
  352.         loop     @@loop
  353.         ; { yo and now decrunch it ... }
  354.         push     ds
  355.         push     bp
  356.         mov      al,[usedchannels]
  357.         mov      dh,al
  358.         les      di,hp          ;{ es:[di] ... pointer to destination }
  359.         lds      si,hp2         ;{ ds:[si] ... pointer to packed data }
  360.  
  361.         xor      ah,ah
  362.         mov      bp,ax
  363.         shl      bp,2
  364.         add      bp,ax          ;{ bp = usedchannels*5 = size of one row }
  365.  
  366.         mov      dl,64 ;{ 64 rows to decrunch }
  367.  
  368. @@rowloop:
  369.         { read first 'crunch' byte for this channel : }
  370.         lodsb                   ;{ I know "mov,inc" would be faster but we }
  371.                                 ;{ don't need speed here }
  372.         cmp      al,0
  373.         jz       @@endofrow
  374. @@dloop:
  375.         mov      cl,al
  376.         xor      bh,bh
  377.         mov      bl,cl
  378.         and      bl,31          ;{ bl = channel to write to }
  379.         cmp      bl,dh          ;{ bl<usedchannels }
  380.         jae      @@overread
  381. @@ok:   mov      ax,bx
  382.         shl      bx,2
  383.         add      bx,ax          ;{ bx = offset from row start to channel to write to }
  384.         test     cl,32
  385.         je       @@nonew_note_instrument
  386.         lodsw
  387.         mov      es:[di+bx],ax
  388. @@nonew_note_instrument:
  389.         test     cl,64
  390.         jz       @@nonew_volume
  391.         lodsb
  392.         mov      es:[di+bx+2],al
  393. @@nonew_volume:
  394.         test     cl,128
  395.         jz       @@nonew_cmd_info
  396.         lodsw
  397.         mov      es:[di+bx+3],ax
  398. @@nonew_cmd_info:
  399.         ;{ read next 'crunch' byte : }
  400.         lodsb
  401.         cmp      al,0
  402.         jnz      @@dloop        ; { if zero then EOR is reached ... }
  403. @@endofrow:  ;{ =EOR :) }
  404.         add      di,bp                  ;{ to next row ...}
  405.         dec      dl
  406.         jnz      @@rowloop
  407.         pop      bp
  408.         pop      ds
  409.         jmp      @@done
  410. @@overread:
  411.         test     cl,32
  412.         je       @@ov1
  413.         lodsw
  414. @@ov1:
  415.         test     cl,64
  416.         jz       @@ov2
  417.         lodsb
  418. @@ov2:
  419.         test     cl,128
  420.         jz       @@ov3
  421.         lodsw
  422. @@ov3:  jmp      @@nonew_cmd_info
  423. @@done:
  424.       end;
  425.       if pattern[patpos-1]>=$C000 then
  426.         begin
  427.           {$IFDEF LOADINFO}
  428.           write('E(',curPpage,',',curpart,')');
  429.           {$ENDIF}
  430.           { next position in EMS : }
  431.           inc(curpart);
  432.           if (curpart=patperpage) and (Ppagesleft>0) then
  433.             begin
  434.               dec(Ppagesleft);inc(curPpage);
  435.               curpart:=0;
  436.             end;
  437.         end;
  438.       {$IFDEF LOADINFO}
  439.       write('*');
  440.       {$ENDIF}
  441.       load_decrunc_pattern:=true;
  442.     END;
  443.  
  444.   function fileexist(s:string):boolean;
  445.   var f:file;
  446.     begin
  447.       assign(f,s);reset(f,1);fileexist:=ioresult=0;close(f);if ioresult<>0 then;
  448.     end;
  449.  
  450. var a,b,c:string;
  451.     Inst_done:boolean;
  452.     load_smp_later:boolean;
  453.     firstSMP:boolean;
  454.  
  455.   BEGIN
  456.     LOAD_S3M := FALSE;
  457.     useEMS:=EMSinstalled and useEMS and (EMSfreepages>1); { we need one page for saving mapping while playing }
  458.     load_error:=0;buffer:=Nil;
  459.     fsplit(name,a,b,c);
  460.     if not fileexist(a+b+c) then name:=a+b+'.S3M';
  461.     assign(f,name);
  462.     reset(f,1);               { open file - 16byte blocks :) }
  463.     IF IORESULT<>0 THEN begin load_error:=filenotexist;exit end;
  464.     { First read fileheader }
  465.     blockread(f,header,sizeof(THeader));
  466.     IF IORESULT<>0 THEN begin load_error:=wrongformat;exit end;
  467.     { check if it's really a S3M ... }
  468.     IF header.filetyp<>16 then begin load_error:=wrongformat;exit end;
  469.     IF not SCRMtest(header.SCRM_ID) then begin load_error:=wrongformat;exit end;
  470.     IF not ST3test(header.CWTV) then begin load_error:=wrongformat;exit end;
  471.     { set some variables : }
  472.     convert2pas(header.name,songname,28);
  473.     ordnum:=header.ordnum;
  474.     insnum:=header.insnum;
  475.     patnum:=header.patnum;
  476.     { setup flags }
  477.     asm
  478.       mov        bx,[header.flags]
  479.       { flag bit 0 }
  480.       xor        al,al
  481.       shr        bx,1
  482.       rcl        al,1
  483.       mov        [st2vibrato],al
  484.       { flag bit 1 }
  485.       xor        al,al
  486.       shr        bx,1
  487.       rcl        al,1
  488.       mov        [st2tempo],al
  489.       { flag bit 2 }
  490.       xor        al,al
  491.       shr        bx,1
  492.       rcl        al,1
  493.       mov        [amigaslides],al
  494.       { flag bit 3 }
  495.       xor        al,al
  496.       shr        bx,1
  497.       rcl        al,1
  498.       mov        [vol0opti],al
  499.       { flag bit 4 }
  500.       xor        al,al
  501.       shr        bx,1
  502.       rcl        al,1
  503.       mov        [amigalimits],al
  504.       { flag bit 5 }
  505.       xor        al,al
  506.       shr        bx,1
  507.       rcl        al,1
  508.       mov        [SBfilter],al
  509.       { flag bit 7 }
  510.       xor        al,al
  511.       shr        bx,2
  512.       rcl        al,1
  513.       mov        [costumeflag],al
  514.     end;
  515.     savedunder:=(header.cwtv shr 8) and $0f+0.1*((header.cwtv shr 4) and $0f+0.01*(header.cwtv and $0f));
  516.     signeddata:=(header.ffv=1);if not (header.ffv in [1,2]) then begin load_error:=wrongformat;exit end;
  517.     gvolume:=header.gvolume;
  518.     mvolume:=header.mvolume and $7f;
  519.     stereo :=(header.mvolume shr 7)=1;  { bit 7 is stereo flag ... }
  520.     initspeed:=header.initialspeed;
  521.     inittempo:=header.initialtempo;
  522.     { setup channels : }
  523.     maxused:=0;
  524.     for i:=0 to 31 do
  525.       begin
  526.         channel[i].enabled:=(header.channelset[i] and 128=0);
  527.         channel[i].channeltyp:=getchtyp(header.channelset[i] and 31);
  528.         if channel[i].enabled and (channel[i].channeltyp>0) and (channel[i].channeltyp<3) then maxused:=i+1;
  529.       end;
  530.     usedchannels:=maxused;
  531.     {$IFDEF BETATEST}
  532.     writeln(' Used channels :',usedchannels);
  533.     {$ENDIF}
  534.     { now load arrangment : }
  535.     blockread(f,Order,ordnum);
  536.     IF IORESULT<>0 THEN begin load_error:=filecorrupt;exit end;
  537.     { check order if there's one 'real' (playable) entry ... }
  538.     i:=0;while (i<ordnum) and (order[i]>=254) do inc(i);
  539.     if i=ordnum then begin load_error:=ordercorrupt;exit end; { playable entry not found :( }
  540.     blockread(f,inspara,insnum*2);
  541.     IF IORESULT<>0 THEN begin load_error:=filecorrupt;exit end;
  542.     blockread(f,patpara,patnum*2);
  543.     IF IORESULT<>0 THEN begin load_error:=filecorrupt;exit end;
  544.     close(f);
  545.     { Ok now the difficult part ...
  546.       (load patterns/samples/instrumentdata)
  547.       - load them in a row (don't jump through the file, that costs time !
  548.       - problem is that you don't know the order and possibly there's no !
  549.     }
  550.     patlength:=5*64*usedchannels;
  551.     {$IFDEF BETATEST}
  552.     writeln(' length of Patterns in memory: ',patlength);
  553.     {$ENDIF}
  554.     if useEMS then
  555.       begin
  556.         { we use EMS, then we need a page to save mapping in interrupt ! }
  557.         savHandle:=EMSalloc(1); { 1 page is enough ? }
  558.         { let's continue with loading: }
  559.         PatPerPage:=(16*1024) div patlength;
  560.         {$IFDEF BETATEST}
  561.         writeln(' Patterns per Page: ',patperpage);
  562.         {$ENDIF}
  563.         { try to allocate EMS for all patterns : }
  564.         if (EMSfreepages<(patnum+(patperpage-1)) div patperpage) then
  565.           begin
  566.             Ppagesleft:=EMSfreepages;patEMShandle:=EMSalloc(Ppagesleft);EMSpat:=true;
  567.           end
  568.         else
  569.           begin
  570.             patEMShandle:=EMSalloc((patnum+(patperpage-1)) div patperpage);
  571.             Ppagesleft:=(patnum+(patperpage-1)) div patperpage;EMSpat:=true
  572.           end;
  573.       end;
  574.     if useEMS and EMSpat then
  575.       begin
  576.         curpart:=0;curPpage:=0;
  577.       end;
  578.     { clear all samples }
  579.     fillchar(instruments^,max_samples*5*16,0);
  580.     { Now try to load everything in a row }
  581.     {$IFDEF LOADINFO}
  582.     writeln(#10#13'load report :');
  583.     {$ENDIF}
  584.     reset(f,1);
  585.     fileposit:=0; { at start :) }
  586.     Inst_done:=false;  { Instrument are not loaded yet :) }
  587.     load_smp_later:=false; { load instruments not later (up to now we can say only this) }
  588.     firstSMP:=true; { if we load now an instrument, then it's the first =) }
  589.     { init buffer for fast loading : }
  590.     if not getdosmem(buffer,10*1024) then begin load_error:=notenoughmem;exit end;
  591.     { init some variables for loading : }
  592.     inspos:=1;patpos:=0;smppos:=0;smpnum:=0;nextpat:=$7fffffff;nextins:=$7fffffff;nextsmp:=$7fffffff;
  593.     while (inspos<insnum+1) or (patpos<patnum) or (smppos<smpnum)
  594.           or (nextpat<$7fffffff) or (nextins<$7fffffff) or (nextsmp<$7fffffff) do
  595.       begin
  596.         {writeln('--->',inspos,',',patpos,',',smppos);readkey;}
  597.         if (nextpat=$7fffffff) and (patpos<patnum) then
  598.           begin
  599.             nextpat:=patpara[patpos];inc(patpos)
  600.           end;
  601.         if (nextins=$7fffffff) and (inspos<insnum+1) then
  602.           begin
  603.             nextins:=inspara[inspos];inc(inspos)
  604.           end;
  605.         if (nextsmp=$7fffffff) and (smppos<smpnum) then
  606.           begin
  607.             nextsmp:=smppara[smppos];inc(smppos)
  608.           end;
  609.         if (nextpat<nextins) and (nextpat<nextsmp) then
  610.           begin
  611.             { pattern }
  612.             if (nextpat<$7fffffff) then
  613.               if not load_decrunc_pattern then begin freeallmem;exit end;
  614.             nextpat:=$7fffffff;
  615.           end
  616.         else
  617.         if (nextins<nextsmp) then
  618.           begin
  619.             { instrument }
  620.             if (nextins<$7fffffff) then
  621.               if not load_instrument then begin freeallmem;exit end;
  622.             nextins:=$7fffffff;inst_done:=(inspos=insnum+1);
  623.           end
  624.         else { sampledata }
  625.           begin
  626.             if (nextsmp>0) and not load_smp_later then
  627.               begin
  628.                 if not Inst_done and useEMS then load_smp_later:=true
  629.                 { if all instruments are not loaded yet and we want to load into the EMS then
  630.                 stop loading here - do it after all Instruments are done ... }
  631.                   else
  632.                     begin
  633.                       if useEMS and firstSMP then begin allocEMSforSamples;firstSMP:=false end;
  634.                       if (nextsmp<$7fffffff) then
  635.                       if not load_sample then begin freeallmem;exit end;
  636.                     end;
  637.               end;
  638.             nextsmp:=$7fffffff;
  639.           end;
  640.         if keypressed then
  641.           if readkey=#27 then
  642.             begin
  643.               writeln(' Somethings going wrong with loading ? Or why do you pressed <ESC> ?');
  644.               writeln(' If loading error - please report me.');
  645.               load_error:=internal_failure;
  646.               freeallmem;
  647.               exit;
  648.             end;
  649.       end;
  650.     { And now for ugly orders :
  651.       if instrumentdata was not fully loaded as the first sampledata starts,
  652.       then we have to wait, coze we don't know how many EMS we should acolate
  653.       now we know it so let's start again at the beginning of the file and
  654.       load the samples in a row ... }
  655.     if UseEMS and load_smp_later then
  656.       begin
  657.         reset(f,1);
  658.         fileposit:=0; { again to start }
  659.         allocEMSforSamples;
  660.         smppos:=0;smpnum:=0;nextpat:=$7fffffff;nextins:=$7fffffff;nextsmp:=$7fffffff;
  661.         while (smppos<smpnum) or (nextsmp<$7fffffff) do
  662.           begin
  663.             if (nextsmp=$7fffffff) and (smppos<smpnum) then
  664.               begin
  665.                 nextsmp:=smppara[smppos];inc(smppos)
  666.               end;
  667.             if (nextsmp<$7fffffff) then
  668.               if not load_sample then begin freeallmem;exit end;
  669.             nextsmp:=$7fffffff;
  670.           end;
  671.       end;
  672.     {$IFDEF BETATEST}
  673.     writeln(#10);
  674.     {$ENDIF}
  675.     { free buffer : }
  676.     freedosmem(buffer);
  677.     { Just for fun set names for EMS handles (does only work for EMS>= v4.0) }
  678.     if EMSversion>=4.0 then setEMSnames;
  679.     S3M_inMemory:=true;
  680.     LOAD_S3M :=TRUE;
  681.   END;
  682.  
  683. FUNCTION load_specialdata(var p):boolean; BEGIN { not implemented } END;